home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
PASCAL
/
0188.ZIP
/
ITRMDIAL.INC
< prev
next >
Wrap
Text File
|
1985-02-20
|
8KB
|
278 lines
Const
MAXPHONES = 20; {maximum # of phone dir entries}
PHONE_FILE_NAME = 'ITERM.PHN'; {phone directory}
HAYES_INIT = 'AT V0';
DIAL_COMMAND = 'AT DT';
Type
PhoneEntry = record
name : string[20];
number : string[14];
dir_baud : integer;
dir_dbits : 7..8;
dir_stop_bits : 1..2;
dir_parity : parity_set;
id : string[20];
pw : string[20];
paced : boolean;
FilterSet : cset;
end;
Var
phones : array[1..MAXPHONES] of PhoneEntry;
phfile : file of PhoneEntry;
cflag : boolean; {flag change in phone directory}
CurPhone : Integer;
function getword(var s : bigstring; i : integer; var out : bigstring) : integer;
{ get word from s[i] into out }
const
BLANK = ' ';
TAB = #09;
COMMA = ',';
begin
out := '';
while (s[i] in [BLANK, TAB, COMMA]) and (i <= length(s)) do
i := i + 1;
while (not (s[i] in [BLANK, TAB, COMMA])) and (i <= length(s)) do
begin
out := out + s[i];
i := i + 1
end;
if i < length(s) then
getword := i
else
getword := 0
end;
procedure MakeFilter(var b: bigstring; var c : cset);
var bb : integer;
junk : integer;
begin
val(b, bb, junk);
if (junk = 0) and (bb <= 127) then
c := c + [bb]
end;
procedure GetParms;
var
p : string[4];
begin
writeln('Current Parameters:');
writeln('Baud Rate:',speed:6);
writeln('Data Bits:',dbits:6);
writeln('Stop Bits:',stop_bits:6);
case parity of
even : p := 'EVEN';
none : p := 'NONE';
else p := '????'
end;
writeln('Parity: ',p:6);
writeln;
write('Change? (Y/N) ');
readln(p);
if length(p) > 0 then
if upcase(p) = 'Y' then
begin
write('New Baud Rate (<cr> to keep): ');
readln(speed);
write('New Data Bits (<cr> to keep): ');
readln(dbits);
write('New Stop Bits (<cr> to keep): ');
readln(stop_bits);
write('New Parity (E or N or <cr> to keep): ');
readln(p);
if length(p) > 0 then
case upcase(p) of
'E' : parity := even;
else parity := none;
end
end
end;
procedure NewParms;
begin
OpenTemp(20,7,60,22,2);
GetParms;
CloseTemp;
update_uart;
New_Baud(speed)
end;
procedure InitPhn;
var
i : integer;
begin
cflag := false;
term_ready(TRUE);
assign(phfile,PHONE_FILE_NAME);
if exists(PHONE_FILE_NAME) then
begin
reset(phfile);
for i := 1 to MAXPHONES do
read(phfile, phones[i])
end
else
begin
rewrite(phfile);
with phones[1] do
begin
name := '';
number := '';
dir_baud := 300;
dir_dbits := 7;
dir_stop_bits := 1;
dir_parity := even;
id := '';
pw := '';
paced := TRUE;
FilterSet := []
end;
for i := 1 to MAXPHONES do
begin
phones[i] := phones[1];
write(phfile, phones[1])
end
end;
close(phfile)
end;
procedure ListPhones;
var
i : integer;
begin
for i := 1 to MAXPHONES div 2 do
begin
write(i:2, ': ', phones[i].name);
GotoXY(40,WhereY);
writeln(i+MAXPHONES div 2:2,': ', phones[i + MAXPHONES div 2].name)
end
end;
procedure DialModem(entry : integer);
var
i : integer;
UserBrk : char;
begin
speed := phones[entry].dir_baud;
dbits := phones[entry].dir_dbits;
stop_bits := phones[entry].dir_stop_bits;
parity := phones[entry].dir_parity;
DiscardSet := phones[entry].FilterSet;
update_uart;
new_baud(speed);
StrSend(HAYES_INIT);
StrSend(DIAL_COMMAND);
StrSend(phones[entry].number);
purge;
send(13);
i := cgetc(1);
status(2,'Awaiting Remote');
repeat
i := cgetc(0);
if KeyPressed then
read(kbd,UserBrk);
until (i <> -1) or (UserBrk = ^X);
write(#13,#10, phones[entry].name);
if (i and $7F) = $31 {'1'} then
begin
status(2,'On-Line/Ready');
writeln(' Connected.')
end
else
begin
status(2,'Off-Line/Ready');
case UserBrk of
^X : begin
Writeln(' -- Call interrupted.');
send(13); send(13); purge;
end;
else writeln(' Does not answer.')
end
end;
purge
end;
{$V-}
Procedure Auto_Dial;
type
str40 = string[40];
var
i,valcode : integer;
c : string[2];
newset, element : bigstring;
Procedure ChangeOption(prompt : str40; var s : str40);
var
temp : str40;
begin
writeln('Current ',prompt,': ',s);
write(prompt,' (<cr> to keep): '); readln(temp);
if Length(temp) > 0 then
s := temp
end;
begin
OpenTemp(10,5,70,19,2);
ListPhones;
write('Enter number to dial, (C)hange or <cr> to Quit --> ');
readln(c);
val(c, Curphone, valcode);
if length(c) = 0 then
CloseTemp
else if valcode > 0 then
begin
repeat
write('Enter line number to change --> ');
readln(CurPhone);
until (CurPhone > 0) and (CurPhone <= MAXPHONES);
with phones[CurPhone] do
begin
writeln;
ChangeOption('Name',name);
ChangeOption('Phone', number);
GetParms;
writeln;
dir_baud := speed;
dir_dbits := dbits;
dir_stop_bits := stop_bits;
dir_parity := parity;
ChangeOption('User ID', id);
ChangeOption('Password', pw);
write('Need echo on macros? (Y/N; default Y)');
readln(c);
paced := TRUE;
if length(c) > 0 then
if upcase(c[1]) = 'N' then
paced := FALSE;
cflag := TRUE;
writeln;
writeln('Now filtering:');
for i := 1 to 127 do
if i in FilterSet then
write(i,',');
writeln; write('Enter a new list of ASCII codes to filter,');
writeln('or <cr> to keep the current set.');
write('? '); readln(newset);
if length(newset) > 0 then
begin
i := 1;
while i > 0 do
begin
i := getword(newset,i,element);
MakeFilter(element,FilterSet)
end
end;
CloseTemp;
writeln(#13,#10,'───ITERM: Phone directory entry made.───')
end;
end
else if valcode = 0 then
begin
CloseTemp;
DialModem(CurPhone)
end
end;
{$V+}